home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfwd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-19  |  14.2 KB  |  357 lines
  1. (*===========================================================================*)
  2. (* Forward task                                                              *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. UNIT BBFWD;
  10.  
  11. INTERFACE
  12.  
  13.   PROCEDURE forward_task_start;
  14.  
  15. IMPLEMENTATION
  16.  
  17.   USES
  18.     bbact,
  19.     bbdummy,
  20.     bbfwdd,
  21.     bbfwdp,
  22.     bbfwdr,
  23.     bbhlook,
  24.     bbmem,
  25.     bbmisc6,
  26.     bbsema2,
  27.     bbsess,
  28.     bbstr,
  29.     bbtask,
  30.     bbtime,
  31.     bbwakeup,
  32.     bbwin;
  33.  
  34. PROCEDURE fwd_now(port_to_fwd : str8);  FORWARD;
  35.  
  36. (*===========================================================================*)
  37. (* Forward task control                                                      *)
  38. (*===========================================================================*)
  39.  
  40. PROCEDURE forward_task_start;
  41.  
  42.   VAR
  43.     fwd_to_ports : str8;
  44.  
  45.   BEGIN;
  46.  
  47.     (*-----------------------------------------------------------------------*)
  48.     (* Add a wait                                                            *)
  49.     (*-----------------------------------------------------------------------*)
  50.  
  51.     task_wait (2, FALSE);
  52.  
  53.     (*-----------------------------------------------------------------------*)
  54.     (* Do this stuff first                                                   *)
  55.     (*-----------------------------------------------------------------------*)
  56.  
  57.     load_action(#1);
  58.  
  59.     (*-----------------------------------------------------------------------*)
  60.     (* This task loops forever                                               *)
  61.     (*-----------------------------------------------------------------------*)
  62.  
  63.     WHILE TRUE DO
  64.       BEGIN;
  65.  
  66.         (*-------------------------------------------------------------------*)
  67.         (* Rotate tasks                                                      *)
  68.         (*-------------------------------------------------------------------*)
  69.  
  70.         task_switch;
  71.  
  72.         (*-------------------------------------------------------------------*)
  73.         (* Set port id....                                                   *)
  74.         (*-------------------------------------------------------------------*)
  75.  
  76.         active_port := @dummy_port;
  77.         active_tcb^.port_chan_s := 'FO';
  78.  
  79.         (*-------------------------------------------------------------------*)
  80.         (* Handle forward command                                            *)
  81.         (*-------------------------------------------------------------------*)
  82.  
  83.         IF fwd_command <> '' THEN
  84.           BEGIN;
  85.  
  86.             (*---------------------------------------------------------------*)
  87.             (* If not XSTOP then execute forward now                         *)
  88.             (*---------------------------------------------------------------*)
  89.  
  90.             IF fwd_command <> 'XSTOP' THEN
  91.               fwd_now('*');
  92.  
  93.             (*---------------------------------------------------------------*)
  94.             (* Remove any XSTOP.  If you are wondering why this is a         *)
  95.             (* separate statement instead of being an ELSE off the previous  *)
  96.             (* one, it is because the FWD_NOW can take hours to return!      *)
  97.             (* The removal of XSTOP is needed in that case so we don't       *)
  98.             (* accidently abort a timed forward when we have aborted a       *)
  99.             (* commanded "forward".  This was learned by experience!         *)
  100.             (*---------------------------------------------------------------*)
  101.  
  102.             IF fwd_command = 'XSTOP' THEN
  103.               fwd_command := '';
  104.  
  105.           END;
  106.  
  107.         (*-------------------------------------------------------------------*)
  108.         (* Handle forward time.                                              *)
  109.         (*-------------------------------------------------------------------*)
  110.  
  111.         fwd_to_ports := find_forward_port;
  112.  
  113.         IF fwd_to_ports <> '' THEN
  114.           BEGIN;
  115.  
  116.             active_port := @dummy_port;
  117.  
  118.             (*---------------------------------------------------------------*)
  119.             (* Hlookup                                                       *)
  120.             (*---------------------------------------------------------------*)
  121.  
  122.             IF opt_block.opt_auto_hlookup THEN
  123.               BEGIN;
  124.                 fwd_out_busy := TRUE;
  125.                 h_look_up('GH');
  126.                 fwd_out_busy := FALSE;
  127.               END;
  128.  
  129.             (*---------------------------------------------------------------*)
  130.             (* Forward to the port                                           *)
  131.             (*---------------------------------------------------------------*)
  132.  
  133.             fwd_now(fwd_to_ports);
  134.  
  135.             (*---------------------------------------------------------------*)
  136.             (* Remove an XSTOP if any                                        *)
  137.             (*---------------------------------------------------------------*)
  138.  
  139.             IF fwd_command = 'XSTOP' THEN
  140.               fwd_command := '';
  141.  
  142.             (*---------------------------------------------------------------*)
  143.             (* Schedule next forward                                         *)
  144.             (*---------------------------------------------------------------*)
  145.  
  146.             sked_forward_port(fwd_to_ports);
  147.  
  148.             (*---------------------------------------------------------------*)
  149.             (* Force some relief to other tasks                              *)
  150.             (*---------------------------------------------------------------*)
  151.  
  152.             task_switch;
  153.  
  154.           END;
  155.  
  156.         active_port := @dummy_port;
  157.  
  158.         (*-------------------------------------------------------------------*)
  159.         (* WAKEUP time????                                                   *)
  160.         (*-------------------------------------------------------------------*)
  161.  
  162.         IF (wakeup_time < current_day_time) OR (wakeup_force) THEN
  163.           BEGIN;
  164.             fwd_out_busy := TRUE;
  165.             wakeup_force := FALSE;
  166.             wakeup;
  167.             fwd_out_busy := FALSE;
  168.           END;
  169.  
  170.       END; (*----- End of forever loop --------------------------------------*)
  171.  
  172.   END;
  173.  
  174. (*===========================================================================*)
  175. (* Forward now                                                               *)
  176. (*===========================================================================*)
  177.  
  178. PROCEDURE fwd_now(port_to_fwd : str8);
  179.  
  180.   VAR
  181.     path_common  : path_block;
  182.     sked_port    : port_block_ptr;
  183.  
  184.   BEGIN;
  185.  
  186.     (*-----------------------------------------------------------------------*)
  187.     (* Mark that we are forwarding                                           *)
  188.     (*-----------------------------------------------------------------------*)
  189.  
  190.     fwd_out_busy := TRUE;
  191.  
  192.     WITH path_common DO
  193.       BEGIN;
  194.  
  195.         (*-------------------------------------------------------------------*)
  196.         (* Initialize the path block                                         *)
  197.         (*-------------------------------------------------------------------*)
  198.  
  199.         FILLCHAR(path_common, SIZEOF(path_common), CHR(0));
  200.  
  201.         path_sub_sw := TRUE;
  202.  
  203.         (*-------------------------------------------------------------------*)
  204.         (* Check where command came from                                     *)
  205.         (*-------------------------------------------------------------------*)
  206.  
  207.         IF port_to_fwd <> '*' THEN
  208.  
  209.           (*-----------------------------------------------------------------*)
  210.           (* Command via port start                                          *)
  211.           (*-----------------------------------------------------------------*)
  212.  
  213.           path_port_p := port_to_fwd
  214.  
  215.         ELSE
  216.           BEGIN;
  217.  
  218.             (*---------------------------------------------------------------*)
  219.             (* Command via console, check for options                        *)
  220.             (*---------------------------------------------------------------*)
  221.  
  222.             (*---------------------------------------------------------------*)
  223.             (* Port option process                                           *)
  224.             (*---------------------------------------------------------------*)
  225.  
  226.             IF subword(@fwd_command, 2, 1) = 'PORT' THEN
  227.               BEGIN;
  228.  
  229.                 (*-----------------------------------------------------------*)
  230.                 (* Port option! Remove the word PORT                         *)
  231.                 (*-----------------------------------------------------------*)
  232.  
  233.                 fwd_command := subword(@fwd_command, 3, 0);
  234.  
  235.                 (*-----------------------------------------------------------*)
  236.                 (* If here is something following the word, save it as       *)
  237.                 (* the port name                                             *)
  238.                 (*-----------------------------------------------------------*)
  239.  
  240.                 IF LENGTH(fwd_command) <> 0 THEN
  241.                   path_port_p := fwd_command
  242.                 ELSE
  243.                   path_port_p := '?';
  244.  
  245.                 (*-----------------------------------------------------------*)
  246.                 (* Remove the port name from the command                     *)
  247.                 (*-----------------------------------------------------------*)
  248.  
  249.                 fwd_command := subword(@fwd_command, 2, 0);
  250.  
  251.               END
  252.             ELSE
  253.               BEGIN;
  254.  
  255.                 (*-----------------------------------------------------------*)
  256.                 (* Port option not specified.  Remove front of command       *)
  257.                 (*-----------------------------------------------------------*)
  258.  
  259.                 fwd_command := subword(@fwd_command, 2, 0);
  260.  
  261.                 (*-----------------------------------------------------------*)
  262.                 (* Set to any port                                           *)
  263.                 (*-----------------------------------------------------------*)
  264.  
  265.                 path_port_p := '*';
  266.  
  267.               END;
  268.  
  269.             (*---------------------------------------------------------------*)
  270.             (* If the word FORCE was specified, set the flag for it          *)
  271.             (*---------------------------------------------------------------*)
  272.  
  273.             path_pattern := 'FORCE';
  274.             IF find(@fwd_command, @path_pattern) <> 0 THEN
  275.               path_force_sw := TRUE;
  276.  
  277.             (*---------------------------------------------------------------*)
  278.             (* Save the path pattern                                         *)
  279.             (*---------------------------------------------------------------*)
  280.  
  281.             path_pattern := subword(@fwd_command, 1, 1);
  282.  
  283.             (*---------------------------------------------------------------*)
  284.             (* Eradicate the forward command buffer to ready it for next     *)
  285.             (* time                                                          *)
  286.             (*---------------------------------------------------------------*)
  287.  
  288.             fwd_command := '';
  289.  
  290.           END;
  291.  
  292.         (*-------------------------------------------------------------------*)
  293.         (* If a path pattern wasn't specified, assume one                    *)
  294.         (*-------------------------------------------------------------------*)
  295.  
  296.         IF path_pattern = '' THEN
  297.           path_pattern := '*';
  298.  
  299.         (*-------------------------------------------------------------------*)
  300.         (* Tell operator what is happening                                   *)
  301.         (*-------------------------------------------------------------------*)
  302.  
  303.         window_write('FO::', '====> Forward cycle start -- '
  304.                                                    + path_port_p + ' -- '
  305.                                                    + path_pattern + ' <====' );
  306.  
  307.         (*-------------------------------------------------------------------*)
  308.         (* Switch away for once                                              *)
  309.         (*-------------------------------------------------------------------*)
  310.  
  311.         task_switch;
  312.  
  313.         (*-------------------------------------------------------------------*)
  314.         (* Process routes                                                    *)
  315.         (*-------------------------------------------------------------------*)
  316.  
  317.         do_route;
  318.  
  319.         (*-------------------------------------------------------------------*)
  320.         (* Switch away for once                                              *)
  321.         (*-------------------------------------------------------------------*)
  322.  
  323.         task_switch;
  324.  
  325.         (*-------------------------------------------------------------------*)
  326.         (* Process paths                                                     *)
  327.         (*------------------------------------------------------------------*)
  328.  
  329.         IF NOT msg_route_force THEN
  330.           do_path(@path_common);
  331.  
  332.         (*-------------------------------------------------------------------*)
  333.         (* Clean things up                                                   *)
  334.         (*-------------------------------------------------------------------*)
  335.  
  336.         free_semaphore(semaphore_fwd_route_use);
  337.  
  338.         free_task_mem_all(active_tcb);
  339.  
  340.         (*-------------------------------------------------------------------*)
  341.         (* Tell operator we are done                                         *)
  342.         (*-------------------------------------------------------------------*)
  343.  
  344.         window_write('FO::', '=====> Forward cycle end <=====');
  345.  
  346.       END;
  347.  
  348.     (*-----------------------------------------------------------------------*)
  349.     (* Forward complete                                                      *)
  350.     (*-----------------------------------------------------------------------*)
  351.  
  352.     fwd_out_busy := FALSE;
  353.  
  354.   END;
  355.  
  356. END.
  357.